perm filename PLOT.XX0[11,ALS] blob
sn#065553 filedate 1973-10-05 generic text, type T, neo UTF8
00010 BEGIN "PLOT"
00020 DEFINE ⊂="COMMENT"; ⊂ AUG.2,1973;
00030 DEFINE ⊃="⊂";
00040 DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00050 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00060 ⊂ REQUIRE "BLOCKS.HDR[4,ALS]" SOURCE_FILE;
00070 LABEL STARTP,STOPP;
00080 INTEGER ARRAY DPYBUF[0:4095];
00090 INTEGER ARRAY LFILE[0:'177];
00100 INTEGER ARRAY SYMBOL[0:127];
00110 INTEGER ARRAY DAT,AVDAT[0:23];
00120 STRING ARRAY SAMPLE[0:127];
00130 INTEGER I,J,K,L,M,N,P,PP,Q,R,POINTX,STATE,DELTA,VAL,CHAN1,EOF,POINTT,POINTV;
00140 INTEGER PT0,PT1,PT2,X0,X1,Y0,Y1,X2,Y2,PTCNT,PICK,OPT,SHUFCT;
00150 INTEGER II,JJ,KK,NN,SEGC,BRK,EOFA,READ3,SEGTOT,SEGIN,IIT,JJT,KKT,NNT,SEGCT;
00160 BOOLEAN ER;
00170 INTEGER CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,CHANX;
00180 INTEGER ARRAY BUF,BUFT[0:511];
00190 STRING FILEN,READ,READ1,FILEO,READ2,FILEQ,TFILE,FILLST;
00200
00210 PROCEDURE OUTALL(STRING S);
00220 BEGIN
00230 STRING SS; INTEGER J;
00240 SETBREAK(18,0,NULL,"OSN");
00250 SS←SCAN(S,18,J);
00260 OUTSTR(SS);
00270 END;
00280
00290 PROCEDURE DATAIN;
00300 BEGIN
00310 INTEGER J;
00320 FOR J←0 STEP 1 UNTIL 511 DO BUF[J]←0;
00330 IF EOF=0 THEN ARRYIN(CHAN1,BUF[0],512)
00340 ELSE OUTSTR("No more data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00350 POINTX←POINT(12,BUF[0],-1);
00360 SEGC←II←II+12; JJ←II+11;
00370 END;
00380
00390 PROCEDURE DATTIN;
00400 BEGIN
00410 INTEGER J;
00420 FOR J←0 STEP 1 UNTIL 511 DO BUFT[J]←0;
00430 IF EOFA=0 THEN ARRYIN(CHAN2,BUFT[0],512)
00440 ELSE OUTSTR("No more T0X data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00450 POINTT←POINT(6,BUFT[0],-1);
00460 SEGCT←IIT←IIT+128; JJT←IIT+127;
00470 END;
00480
00490
00500 PROCEDURE PLOT;
00510 BEGIN
00520 INTEGER I,JP,K,LP;
00530 PTCNT←PTCNT+1; IF PTCNT≤4 THEN BEGIN
00540 POINTV←POINTX;
00550 ⊂ RVECT(128,0); ⊂ RIVECT(-128,0); ⊂ Draw axis;
00560 K←LDB(POINTV); IF K>2047 THEN K←K-4096; K←K%8;
00570 RIVECT(0,K);
00580 FOR I←0 STEP 1 UNTIL 127 DO BEGIN
00590 JP←ILDB(POINTV); IF JP>2047 THEN JP←JP-4096; JP←JP%8;
00600 LP←JP-K; RVECT(1,LP); K←JP; END;
00610 RIVECT(0,-K);
00620 IF PTCNT=4 THEN BEGIN
00630 RIVECT(-200,-130);
00640 READ←CVSTR(SYMBOL[Q])[1 TO 1];
00650 DPYSST(CVXSTR(LFILE[10])[2 TO 3]&" "&READ&" "&CVS(J)&" "&CVS(KK));
00660 RIVECT(60,130); END;
00670 END;END;
00680
00690 PROCEDURE FRIC;
00700 BEGIN
00710 INTEGER JJJ;
00720 ⊂ STATE=0 means on way up
00730 STATE=1 means on way down;
00740 M←0;
00750 PLOT;
00760 FOR JJJ←0 STEP 1 UNTIL 127 DO BEGIN
00770 VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
00780 IF STATE=0 THEN BEGIN
00790 IF VAL<K-DELTA THEN BEGIN
00800 M←M+(K-VAL); STATE←-1; END; END ELSE
00810 IF VAL>K+DELTA THEN BEGIN
00820 M←M+(VAL-K); STATE←0; END;
00830 K←VAL;
00840 IF JJJ=0 THEN M←0;
00850 END;
00860 M←M%100; IF M>63 THEN M←63;
00870 SEGC←SEGC+1;
00880 END;
00890
00900 PROCEDURE DATA;
00910 BEGIN
00920 INTEGER I;
00930 FOR I←0 STEP 1 UNTIL 23 DO BEGIN
00940 DAT[I]←ILDB(POINTT);
00950 AVDAT[I]←AVDAT[I]+DAT[I];
00960 END;
00970 SEGCT←SEGCT+1;
00980 END;
00990
01000 PROCEDURE TYDATT;
01010 BEGIN
01020 INTEGER I,J,K;
01030 K←0;
01040 FOR I←0 STEP 1 UNTIL 23 DO BEGIN
01050 J←ILDB(POINTT);
01060 OUTALL(CVS(J));
01070 END; OUTSTR(CRLF); END;
01080
01090 PROCEDURE SKIP;
01100 BEGIN
01110 INTEGER JJJ;
01120 FOR JJJ←0 STEP 1 UNTIL 127 DO IBP(POINTX);
01130 K←LDB(POINTX); IF K>2047 THEN K←K-4096;
01140 SEGC←SEGC+1;
01150 ⊃ OUTSTR("Skip to segc= "&CVS(SEGC)&CRLF);
01160 END;
01170
01180 PROCEDURE SKIPT;
01190 BEGIN
01200 INTEGER JJJ;
01210 FOR JJJ←0 STEP 1 UNTIL 23 DO IBP(POINTT);
01220 SEGCT←SEGCT+1;
01230 ⊃ OUTSTR("Skip to segct= "&CVS(SEGCT)&CRLF);
01240 END;
01250
01260 PROCEDURE SHUFFLE;
01270 BEGIN "SHUF"
01280 INTEGER I,J,K;
01290
01300 AIVECT(-640,-365);
01310 I←DPYPTR-PT1; ⊂ Words to save;
01320 J←PT1-PT0; ⊂ Words to overwrite;
01330 ⊂ OUTSTR("PT0= "&CVS(PT0)&TB&"PT1= "&CVS(PT1)&TB&"DPYPTR= "&CVS(DPYPTR)&TB);
01340 ⊂ OUTSTR("I= "&CVS(I)&TB&"J= "&CVS(J)&CRLF); ⊂ INCHWL;
01350 FOR K←1 STEP 1 UNTIL I DO DPYBUF[K+3]←DPYBUF[K+3+J];
01360 FOR K←I+1 STEP 1 UNTIL J+I DO DPYBUF[K+3]←1;
01370 PT1←DPYPTR←PT0+I;
01380 ⊂ PTOCHW(0,'10103); DPYOUT(0); PTOCHW(0,'10120);
01390 END "SHUF";
00010 TYPLOC(512,50);
00020 DPYSET(DPYBUF); AIVECT(-640,-90); PT0←DPYPTR;
00030 SHUFCT←0;AIVECT(-640,-365);PT1←DPYPTR;
00040 FILEN←"HI20.001[CMP,JH]";
00050 FILEO←"SEG1.FRI";
00060 ⊂ HEADIN;
00070 STDBRK(1);
00080 SETBREAK(14,"∃",NULL,"INS");
00090 SETBREAK(15,'11&'12&'14&'15&'40,NULL,"INS");
00100 SETBREAK(16,'56,NULL,"INA");
00110 SETBREAK(17,'12,'15,"INS");
00120
00130 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5; CHAN6←6;
00140 OUTSTR("This program will show header information and wave forms for"
00150 &CRLF&" a selected phonette. After every other display it waits for a "
00160 &crlf&" command. A space bar causes it to continue, a letter S causes it "
00170 &CRLF&"start over by asking for a phonette, while an E exits."&CRLF);
00180 OUTSTR("At present this program takes acoustic data from [CMP,JH]"&
00190 CRLF&" and header information from files .T0X[11,ALS]."&CRLF&LF);
00200
00210 CLOSE(CHAN4); OPEN(CHAN4,"DSK",1,2,0,3500,BRK,EOFA);
00220 LOOKUP(CHAN4,"MAP.PHN",ER);
00230 WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find MAP.PHN[NET,NJM]. File = ");
00240 LOOKUP(CHAN4,TFILE←INCHWL,ER); END; EOFA←0;
00250 FILLST←INPUT(CHAN4,14);
00260 ⊂ OUTSTR("MAP.PHN contains "&CRLF&FILLST&CRLF);
00270 CLOSE(CHAN4);
00280
00290 FOR I←0 STEP 1 UNTIL 127 DO BEGIN
00300 WHILE TRUE DO BEGIN
00310 READ1←SCAN(FILLST,17,K);
00320 READ3←READ1[1 TO 1];
00330 IF READ3≠"⊂" THEN DONE; END;
00340 IF READ3="" THEN DONE;
00350 SYMBOL[I]←CVASC(SCAN(READ1,15,K));
00360 SAMPLE[I]←READ1; END;
00370
00380 STARTP:
00390 WHILE TRUE DO BEGIN "PICK"
00400 OUTSTR("Type PH to select (CR for everything) ");
00410 IF (READ←INCHWL)="" THEN DONE ELSE BEGIN PICK←CVASC(READ);
00420 ⊂ OUTALL(CVSTR(PICK)&TB&CVOS(PICK)&TB&TB&CVSTR(SYMBOL[0])&TB&CVOS(SYMBOL[0])&CRLF);
00430 FOR Q←0 STEP 1 UNTIL 127 DO IF PICK=SYMBOL[Q] THEN DONE;
00440 IF Q<128 THEN DONE;
00450 OUTSTR("Not found"&crlf); END; END "PICK";
00460 OUTSTR(CRLF&"You have selected "&tb);
00470 IF READ="" THEN BEGIN OPT←0; OUTSTR("Everything"&crlf); END ELSE BEGIN
00480 OUTALL(CVSTR(PICK)&TB&SAMPLE[Q]&CRLF&" "); OPT←1; END;
00490 DELTA←15;
00500 ⊂ OUTSTR("Specify DELTA (CR for 15) ");
00510 ⊂ IF (READ←INCHWL)="" THEN DELTA←15 ELSE DELTA←CVD(READ);
00520
00530 FOR PP←1 STEP 1 UNTIL 26 DO BEGIN "FILEREAD"
00540 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00550 SETFORMAT(-3,0); FILEQ←CVS(PP);
00560 FILEN←FILEN[1 TO 5]&FILEQ&"[CMP,JH]";
00570 LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
00580 WHILE ER DO BEGIN
00590 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
00600 LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
00610 J←K←L←STATE←VAL←R←0;
00620 SETFORMAT(1,0); FILEQ←CVS(PP);
00630
00640 READ←FILEO[1 TO 3]&FILEQ&".T0X[11,ALS]";
00650 CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOFA);
00660 LOOKUP(CHAN2,READ,ER); TFILE←READ;
00670 WHILE ER DO BEGIN
00680 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
00690 LOOKUP(CHAN2,TFILE←INCHWL,ER); END;
00700 ARRYIN(CHAN2,LFILE[0],'200); ⊂ Input header;
00710 SEGTOT←(LFILE[0]*6)%256;
00720 ⊃ OUTSTR(FILEI&" "&CVS(SEGTOT)&" ");
00730
00740 READ2←READ;
00750 READ1←SCAN(READ2,16,J)&"DOC";
00760 ⊃ OUTSTR("Ready to write "&READ1&TB);
00770 ⊂ OUTSTR(CRLF&" ");
00780 ⊂ FOR I←10 STEP 1 UNTIL 20 DO OUTSTR(CVXSTR(LFILE[I]));
00790 ⊂ OUTSTR(CRLF);
00800 ⊂ OUTSTR("First"&TB&"Average"&TB&"Last"&TB
00810 &"Symbol"&TB&"Start"&TB&"Length"&TB&"Sample"&TB&"Features"&CRLF);
00820
00830 II←-11; JJ←-1; IIT←-127; JJT←-1; SETFORMAT(3,0); SEGIN←0;
00840 FOR I←21 STEP 1 UNTIL 127 DO BEGIN
00850 IF LFILE[I]=0 THEN IF I>0 THEN DONE ELSE BEGIN OUTSTR("No data."&crlf);
00860 done end;
00870 L←LFILE[I] LAND '777760000000;
00880 IF (OPT=0) ∨ (L=PICK) THEN BEGIN "SELECT"
00890 IF SHUFCT=0 THEN BEGIN
00900 OUTSTR(" F1 F3 A2 FP1 FP2 FZ NP NZ LPE HPE HPA PIT"
00910 &CRLF&" F2 A1 A3 FP1A FP2A FZA NPA NZA AVE LPA FRI FRI4"
00920 &CRLF); END;
00930
00940 FOR Q←0 STEP 1 UNTIL 126 DO IF L=SYMBOL[Q] THEN DONE;
00950 J←LDB(POINT(14,LFILE[I],27)); KK←LDB(POINT(8,LFILE[I],35));
00960
00970 IF KK<4 THEN PTCNT←4-KK;
00980 IF KK≤0 THEN OUTSTR(TB&TB&TB) ELSE BEGIN
00990 IF II>J THEN BEGIN
01000 OUTSTR("Out of step with SEGC= "&CVS(SEGC)&", J= "&CVS(J)&" and II= "&
01010 CVS(II)&CRLF);
01020 INCHWL; END;
01030 IF IIT>J THEN BEGIN
01040 OUTSTR("Out of step with SEGCT= "&CVS(SEGCT)&", J= "&CVS(J)&" and IIT= "&
01050 CVS(IIT)&", JJT= "&CVS(JJT)&CRLF);
01060 INCHWL; END;
01070
01080 WHILE JJ<J DO DATAIN; WHILE JJT<J DO DATTIN;
01090 WHILE SEGC<J DO SKIP; WHILE SEGCT<J DO SKIPT;
01100
01110 FRIC;
01120 FOR K←0 STEP 1 UNTIL 23 DO AVDAT[K]←0;
01130 DATA; DAT[23]←M;
01140
01150 OUTSTR("F ");
01160 FOR K←0 STEP 1 UNTIL 23 DO OUTSTR(CVS(DAT[K])); OUTSTR(CRLF);
01170 ⊂ IF M>0 THEN OUTSTR(CVS(M)&TB) ELSE OUTSTR(" "&TB);
01180 N←M;
01190
01200 FOR R←2 STEP 1 UNTIL KK DO BEGIN
01210 IF SEGC>JJ THEN DATAIN;
01220 IF SEGCT>JJT THEN DATTIN;
01230 FRIC; N←N+M; DATA; END;
01240 DAT[23]←M; AVDAT[23]←N;
01250 ⊂ IF N>0 THEN OUTSTR(CVS(N)&TB) ELSE OUTSTR(" "&TB);
01260 ⊂ IF M>0 THEN OUTSTR(CVS(M)&TB) ELSE OUTSTR(" "&TB);
01270 OUTSTR("A ");
01280 FOR K←0 STEP 1 UNTIL 23 DO BEGIN
01290 AVDAT[K]←AVDAT[K]%KK; OUTSTR(CVS(AVDAT[K])); END; OUTSTR(CRLF);
01300 OUTSTR("L ");
01310 FOR K←0 STEP 1 UNTIL 23 DO OUTSTR(CVS(DAT[K])); OUTSTR(CRLF);
01320 END;
01330
01340 ⊂ OUTALL(CVSTR(L)&TB&CVS(J)&TB&CVS(KK)&CRLF);
01350 ⊂ TYDATT;
01360 DPYOUT(0);PTOCHW(0,'10120); PTCNT←0;
01370 SHUFCT←SHUFCT+1; IF SHUFCT<2 THEN BEGIN OUTSTR(LF); RIVECT(40,0); END
01380 ELSE BEGIN CLRBUF; READ←INCHRW; SHUFCT←0; SHUFFLE;
01390 IF (READ="S")∨(READ="s") THEN BEGIN
01400 OUTSTR(LF&"You are starting over"&CRLF);
01410 GOTO STARTP; END;
01420 IF (READ="E")∨(READ="e") THEN GOTO STOPP;
01430 END;
01440 END "SELECT";
01450 END;
01460
01470 END "FILEREAD";
01480 OUTSTR("Data are exhausted"&CRLF&LF); GOTO STARTP;
01490 STOPP:
01500 END "PLOT";